local table_concat = table.concat
local table_insert = table.insert
local table_remove = table.remove
local string_find = string.find
local string_gsub = string.gsub
local string_len = string.len
local string_sub = string.sub
local string_format = string.format
local string_match = string.match
local setmetatable = setmetatable
local assert = assert
local error = error
local print = print
local pairs = pairs
local ipairs = ipairs
local type = type
local G_tostring = tostring

module("xml")

local iterate_children_cb_n = function (state)
	local table, name, index = state.table, state.name, state.index
	while true do
		local child = table[index]
		index = index + 1
		if not child then break end
		if type(child) == "table" and child.label == name then
			state.index = index
			return child
		end
	end
	return nil
end

local iterate_children_cb = function (state)
	local table, index = state.table, state.index
	while true do
		local child = table[index]
		index = index + 1
		if not child then break end
		if type(child) == "table" then
			state.index = index
			return child
		end
	end
	return nil
end

local iterate_children_cb_p = function (state)
	local table, namepat, index = state.table, state.namepat, state.index
	while true do
		local child = table[index]
		index = index + 1
		if not child then break end
		if type(child) == "table" and string_match(child.label, namepat) then
			state.index = index
			return child
		end
	end
	return nil
end

local node_mt = {
	__index = {
		get_first_child_p = function (self, namepat)
			for _, s in ipairs(self) do
				if type(s) == "table" and string_match(s.label, namepat) then
					return s
				end
			end
		end,
		get_first_child = function (self, name)
			for _, s in ipairs(self) do
				if type(s) == "table" and s.label == name then
					return s
				end
			end
		end,
		iterate_children = function (self, name)
			local state = {
				table = self,
				name = name,
				index = 1,
			}
			return name and iterate_children_cb_n or iterate_children_cb, state
		end,
		iterate_children_p = function (self, namepat)
			local state = {
				table = self,
				namepat = namepat,
				index = 1,
			}
			return iterate_children_cb_p, state
		end,
		get_attribute = function (self, name)
			local attr = self.xarg[name]
			if attr then
				attr = attr:gsub("&quot;", "\""):gsub("&amp;", "&")
			end
			return attr
		end,
		get_content = function (self)
			local temp = {}
			for _, s in ipairs(self) do
				if type(s) == "string" then
					table_insert(temp, s)
				end
			end
			return (table_concat(temp):gsub("&quot;", "\""):gsub("&amp;", "&"))
		end,
	},
	__newindex = function () end,
}

local function parseargs(s)
	local arg = {}
	string_gsub(s, "(%w+)=([\"'])(.-)%2", function (w, _, a) arg[w] = a end)
	return arg
end
	
local function remove_xml_comments (s)
	local r = {}
	while string_len(s) > 0 do
		local c_start = string_find(s, "<!--", nil, true)
		if not c_start then
			table_insert(r, s)
			s = ""
		else
			local c_end = string_find(s, "-->", c_start + 5, true)
			if not c_end then
				error("Invalid XML : unclosed comment")
			end
			table_insert(r, string_sub(s, 1, c_start - 1))
			s = string_sub(s, c_end + 3, -1)
		end
	end
	return table_concat(r)
end

local function remove_xml_header (s)
	local r = {}
	while string_len(s) > 0 do
		local c_start = string_find(s, "<?", nil, true)
		if not c_start then
			table_insert(r, s)
			s = ""
		else
			local c_end = string_find(s, "?>", c_start + 3, true)
			if not c_end then
				error("Invalid XML : unclosed header")
			end
			table_insert(r, string_sub(s, 1, c_start - 1))
			s = string_sub(s, c_end + 3, -1)
		end
	end
	return table_concat(r)
end

function parse (s)
	if type(s) ~= "string" then error("Invalid argument to xml.parse()", 2) end
	local stack = {}
	local top = {}
	local ni,c,label,xarg, empty
	local i, j = 1, 1
	s = remove_xml_comments(s)
	s = remove_xml_header(s)
	table_insert(stack, top)
	while true do
		ni,j,c,label,xarg, empty = string_find(s, "<(%/?)(%w+)(.-)(%/?)>", j)
		if not ni then break end
		local text = string_sub(s, i, ni-1)
		if string_len(text) > 0 then -- not string_find(text, "^%s*$") then
			table_insert(top, text)
		end
		if empty == "/" then  -- empty element tag
			table_insert(top, setmetatable({label = label, xarg = parseargs(xarg), empty = 1}, node_mt))
		elseif c == "" then   -- start tag
			top = {label = label, xarg = parseargs(xarg)}
			table_insert(stack, top)   -- new level
		else  -- end tag
			local toclose = table_remove(stack)  -- remove top
			top = stack[#stack]
			if #stack < 1 then
				error("nothing to close with "..label)
			end
			if toclose.label ~= label then
				error("trying to close "..toclose.label.." with "..label)
			end
			table_insert(top, setmetatable(toclose, node_mt))
		end
		i = j + 1
	end
	local text = string_sub(s, i)
	if not string_find(text, "^%s*$") then
		table_insert(stack[#stack], text)
	end
	if #stack > 1 then
		error("unclosed "..stack[#stack].label)
	end
	
	for _, v in ipairs(stack[1]) do
		if type(v) == "table" then
			return v
		end
	end
end

local function convert_attribute(name, value)
	return string_format("%s=%q", name, value)
end

local function convert_attributes(node)
	local temp = {}
	for name, value in pairs(node) do
		table_insert(temp, convert_attribute(name, value))
	end
	return table_concat(temp, " ")
end

local function convert_node(node)
	if type(node) == "string" then
		return node
	elseif type(node) == "table" then
		local empty = not node[1]
		local attrs = convert_attributes(node.xarg)
		if not attrs then
			attrs = ""
		else
			attrs = " "..attrs
		end
		local s = string_format("<%s%s%s>", node.label, attrs, empty and "/" or "")
		if empty then return s end
		local temp = {}
		table_insert(temp, s)
		for _, sub in ipairs(node) do
			table_insert(temp, convert_node(sub))
		end
		table_insert(temp, string_format("</%s>", node.label))
		return table_concat(temp)
	end
end

function tostring(tree)
	return convert_node(tree)
end
node_mt.__tostring = tostring

local function toliteral (v)
	if type(v) == "string" then
		return string_format("%q", v)
	else
		return string_format("%s", G_tostring(v))
	end
end
local function tokeylit (v)
	return "["..toliteral(v).."]"
end

local function realdump(name, value, offset)
	local tvalue = type(value)
	if tvalue == "table" then
		print(offset..tokeylit(name).." = {")
		local s = offset.."\t"
		for k, v in pairs(value) do
			realdump(k, v, s)
		end
		print(offset.."}")
	else
		print(offset..tokeylit(name).." = "..toliteral(value)..",")
	end
end

dump = function(value)
	return realdump("xml", value, "")
end

function get_first_child(node, namepat)
	if type(node) ~= "table" then return end
	for _, sub in ipairs(node) do
		if type(sub) == "table" and string_match(sub.label, namepat) then
			return sub
		end
	end
end

function get_children(node, namepat)
	if type(node) ~= "table" then return end
	local r = {}
	for _, sub in ipairs(node) do
		if type(sub) == "table" and string_match(sub.label, namepat) then
			table_insert(r, sub)
		end
	end
	return r
end
